home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / istfd / ISTFD.MAC.f
Encoding:
Text File  |  1989-03-04  |  55.1 KB  |  1,447 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.5
  3. C---------------------------------------------------------
  4. C Note: txtbsz must be quite big as the buffer will not be filled
  5. C       once it is within maxtoklen of the end of it, and maxtoklen
  6. C       is approx 1300 characters!
  7. C
  8. C Note to installers: if the buffer sizes are too large for your
  9. C     system then if you reduce them to something small (ie like
  10. C     2000 characters) it is suggested that you redefine maxtoklen
  11. C     (inside ISTFD only) to what you consider a reasonable max
  12. C     size for a token, e.g. maxbuff).
  13. C
  14. C       ------------------------------------------------------------
  15. C
  16. C       Fortran Intelligent Difference Outputter
  17. C
  18. C       Malcolm Cohen, NAG Central Office, April 1984
  19. C
  20. C       Revised: February 1986
  21. C
  22. C       ------------------------------------------------------------
  23. C
  24. C                     F.I.D.O. Structure Chart
  25. C                     ========================
  26. C                     (NB: * = Duplicated Module)
  27. C
  28. C                     +------+
  29. C                     | FIDO |
  30. C                     +------+
  31. C                        |
  32. C         +---------+----+----+---------+---------+---------+
  33. C         |         |         |         |         |         |
  34. C     +-------+ +-------+ +-------+ +-------+ +-------+ +-------+
  35. C     | FDARGS| | DOOPT | | INPUT | |*DIFRNT| | DODIF | | RESULT|
  36. C     +-------+ +-------+ +---+---+ +-------+ +---+---+ +-------+
  37. C                             |                   |
  38. C                         +-------+               |
  39. C                         |*RDTOK |               |
  40. C                         +-------+               |
  41. C                                                 |
  42. C        +----------+-----------+----------------+-+
  43. C        |          |           |                  |
  44. C     +------+  +-------+   +-------+          +-------+
  45. C     |ADJBUF|  | FILBUF|   | FNDDIF|          | REPDIF|
  46. C     +------+  +---+---+   +---+---+          +---+---+
  47. C                   |           |                  |
  48. C               +-------+   +-------+              |
  49. C               |*RDTOK |   | MATCH |      +-------+-+---------+
  50. C               +-------+   +---+---+      |         |         |
  51. C                               |      +-------+ +-------+ +-------+
  52. C                           +-------+  | EXTRA | | OUTPOS| | OUTTOK|
  53. C                           |*DIFRNT|  +-------+ +-------+ +-------+
  54. C                           +-------+
  55. C
  56. C
  57. C      +>>>>>>>>>>>>>FNDDIF calls ADVANC when in statement mode
  58. C
  59. C
  60. C      ------------------------------------------------------------
  61.  
  62.         PROGRAM ISTFD
  63.  
  64.         COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
  65.      +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
  66.      +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  67.         INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
  68.      +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
  69.      +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
  70.      +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  71.  
  72.         COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
  73.         INTEGER NMATCH
  74.         LOGICAL LSTDIF,CHKCMT,TKMODE
  75.  
  76.         COMMON/IO/IODTK1,IODCM1,IODTK2,IODCM2,IODLST
  77.         INTEGER IODTK1,IODCM1,IODTK2,IODCM2,IODLST
  78.  
  79.         COMMON/IN/TK1CTL,TK2CTL
  80.         INTEGER TK1CTL,TK2CTL
  81.  
  82.         COMMON/ANSWER/CMTDIF,PRGDIF
  83.         LOGICAL CMTDIF,PRGDIF
  84.  
  85. C---------------------------------------------------------
  86. C    TOOLPACK/1    Release: 2.5
  87. C---------------------------------------------------------
  88. C
  89. C  TKLAST = LAST TOKEN NUMBER
  90. C
  91.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  92.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  93.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  94.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  95.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  96.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  97.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  98.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  99.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  100.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  101.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  102.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  103.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  104.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  105.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  106.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  107.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  108.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  109.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  110.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  111.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  112.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  113.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  114.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  115.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  116.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  117.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  118.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  119.  
  120.         SAVE
  121.  
  122. C Local function types
  123.  
  124.         LOGICAL DIFRNT
  125.  
  126. C
  127. C       Local top-level storage
  128. C
  129.         INTEGER TK1PTH(81),CM1PTH(81),TK2PTH(81),
  130.      +          CM2PTH(81),LSTPTH(81),OPTSTR(134)
  131. C
  132. C       Library routines called from top level
  133. C
  134.         INTEGER OPEN,CREATE,GETARG,ZTKGTI
  135.         EXTERNAL OPEN,CREATE,GETARG,ERROR,ZINIT,ZQUIT,ZTKGTI,REMARK
  136. C
  137. C
  138. C       T O P     L E V E L
  139. C
  140. C
  141. C       Initialise TIE
  142.         CALL ZINIT
  143.  
  144. C       Read paths from command file
  145.  
  146.         IF (GETARG(1,TK1PTH,81).EQ.-100) CALL FDARGS(1,TK1PTH)
  147.         IF (GETARG(2,CM1PTH,81).EQ.-100) CALL FDARGS(2,CM1PTH)
  148.         IF (GETARG(3,TK2PTH,81).EQ.-100) CALL FDARGS(3,TK2PTH)
  149.         IF (GETARG(4,CM2PTH,81).EQ.-100) CALL FDARGS(4,CM2PTH)
  150.         IF (GETARG(5,LSTPTH,81).EQ.-100) CALL FDARGS(5,LSTPTH)
  151.         IF (GETARG(6,OPTSTR,134).EQ.-100) CALL FDARGS(6,OPTSTR)
  152.  
  153. C       Set up option flags -- set up defaults first
  154. C       (With NMATCH, we set it up so that we can choose the default
  155. C        setting according to the TKMODE option - ie 3 statements or
  156. C        7 tokens)
  157.  
  158.         LSTDIF=.TRUE.
  159.         CHKCMT=.FALSE.
  160.         TKMODE=.TRUE.
  161.         NMATCH=-1
  162.         CALL DOOPT(OPTSTR)
  163.         IF (NMATCH.LT.1) THEN
  164.             IF (TKMODE) THEN
  165.                 NMATCH=7
  166.             ELSE
  167.                 NMATCH=3
  168.             END IF
  169.         END IF
  170.  
  171. C       Open required files
  172.  
  173.         IODTK1=OPEN(TK1PTH,0)
  174.         IF (IODTK1.EQ.-1)
  175.      +      CALL ERROR('ISTFD unable to open token path 1')
  176.         IODCM1=OPEN(CM1PTH,0)
  177.         IF (IODCM1.EQ.-1)
  178.      +      CALL ERROR('ISTFD unable to open cmt path 1')
  179.         IODTK2=OPEN(TK2PTH,0)
  180.         IF (IODTK2.EQ.-1)
  181.      +      CALL ERROR('ISTFD unable to open token path 2')
  182.         IODCM2=OPEN(CM2PTH,0)
  183.         IF (IODCM2.EQ.-1)
  184.      +      CALL ERROR('ISTFD unable to open cmt path 2')
  185.         IF (LSTDIF) THEN
  186.             IODLST=CREATE(LSTPTH,1)
  187.             IF (IODLST.EQ.-1)
  188.      +          CALL ERROR('ISTFD unable to open list path')
  189.         END IF
  190.  
  191. C       Initialise token streams
  192.  
  193.         TK1CTL = ZTKGTI(1, IODTK1,IODCM1)
  194.         TK2CTL = ZTKGTI(1, IODTK2,IODCM2)
  195.         IF (TK1CTL.LE.0)
  196.      +      CALL ERROR('ISTFD unable to init token stream 1')
  197.         IF (TK2CTL.LE.0)
  198.      +      CALL ERROR('ISTFD unable to init token stream 2')
  199.  
  200. C       Initialise the buffer pointers, result flags, token counts
  201.  
  202.         TB1CUR=1
  203.         TB1TOP=1
  204.         TX1CUR=0
  205.         TX1TOP=0
  206.         TB2CUR=1
  207.         TB2TOP=1
  208.         TX2CUR=0
  209.         TX2TOP=0
  210.         NUNIT1=0
  211.         NUNIT2=0
  212.         CMTDIF=.FALSE.
  213.         PRGDIF=.FALSE.
  214. C   Pretend that an EOS precedes each file
  215.         TB1TYP(TB1CUR)=TZEOS
  216.         TB2TYP(TB2CUR)=TZEOS
  217.  
  218. C       And finally process the files
  219.  
  220.         CALL INPUT
  221.  1000   IF (DIFRNT(TB1CUR,TB2CUR)) THEN
  222.             CALL DODIF
  223.         ELSE
  224.             CALL INPUT
  225.         END IF
  226.         IF (LASTB1.NE.TZEOF.OR.LASTB2.NE.TZEOF) GO TO 1000
  227.         CALL RESULT(CMTDIF,PRGDIF)
  228.  
  229.         CALL REMARK('[ISTFD Normal Termination]')
  230.         CALL ZQUIT(-2)
  231.  
  232.         END
  233. C ----------------------------------------------------------------------
  234. C
  235. C       F D A R G S   -   Input ISTFD command arguments from the user
  236. C
  237.  
  238.         SUBROUTINE FDARGS(NUMB,PATH)
  239.         INTEGER NUMB,PATH(*)
  240.  
  241.         INTEGER I,PROMPT(21,6)
  242.  
  243.         SAVE PROMPT
  244.  
  245.         INTEGER ZGTCMD
  246.         EXTERNAL ZGTCMD,ZPRMPT
  247.  
  248.         DATA (PROMPT(I,1),I=1,15)/84,111,107,101,110,32,102,
  249.      +                      105,108,101,32,49,58,32,129/
  250.      +(PROMPT(I,2),I=1,17)/67,111,109,109,101,110,116,32,
  251.      +                 102,105,108,101,32,49,58,32,129/
  252.      +(PROMPT(I,3),I=1,15)/84,111,107,101,110,32,102,105,
  253.      +                 108,101,32,50,58,32,129/
  254.      +(PROMPT(I,4),I=1,17)/67,111,109,109,101,110,116,32,
  255.      +                 102,105,108,101,32,50,58,32,129/
  256.      +(PROMPT(I,5),I=1,15)/76,105,115,116,105,110,103,32,
  257.      +                 102,105,108,101,58,32,129/
  258.      +(PROMPT(I,6),I=1,21)/80,114,111,99,101,115,115,105,110,
  259.      +  103,32,111,112,116,105,111,110,115,58,32,129/
  260.  
  261.  
  262.         CALL ZPRMPT(PROMPT(1,NUMB))
  263.         I=ZGTCMD(PATH,0)
  264.  
  265.         END
  266. C ----------------------------------------------------------------------
  267. C
  268. C       D O O P T   -   Decode the option string
  269. C
  270.  
  271.         SUBROUTINE DOOPT(OPTSTR)
  272.         INTEGER OPTSTR(*)
  273.  
  274.         COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
  275.         INTEGER NMATCH
  276.         LOGICAL LSTDIF,CHKCMT,TKMODE
  277.  
  278.         INTEGER OPTTBL(43),YESNOX(8),MODE(17),STRING(134),POINT
  279.         INTEGER LHS(134),RHS(134),OPTION,OPTARG
  280.  
  281.         SAVE /OPTS/,OPTTBL,YESNOX,MODE
  282.  
  283.         INTEGER GETWRD,ZKWLUK,CTOI,ZSPLIT,ALLDIG
  284.         EXTERNAL GETWRD,ZCHOUT,PUTLIN,ZMESS,ZKWLUK,CTOI,ZSPLIT,SCOPY,
  285.      +           ALLDIG
  286.  
  287.         DATA OPTTBL/6,
  288.      +      99,111,109,109,101,110,116,95,99,104,101,
  289.      +99,107,129,
  290.      +      108,105,115,116,129,
  291.      +      109,111,100,101,129,
  292.      +      110,109,97,116,99,104,129,
  293.      +      110,111,110,101,129,
  294.      +      113,117,105,99,107,129/
  295.         DATA YESNOX/2,
  296.      +      121,101,115,129,
  297.      +      110,111,129/,
  298.      +       MODE/2,
  299.      +      115,116,97,116,101,109,101,110,116,129,
  300.      +      116,111,107,101,110,129/
  301.  
  302.         POINT=1
  303.  
  304.  100    IF (GETWRD(OPTSTR,POINT,STRING).EQ.0) RETURN
  305.         IF (ZSPLIT(STRING,LHS,RHS).NE.-2) THEN
  306.             CALL SCOPY(STRING,1,LHS,1)
  307.             RHS(1)=129
  308.         END IF
  309.         OPTION=ZKWLUK(LHS,OPTTBL)
  310.         IF (OPTION.LE.0) THEN
  311.             IF (OPTION.EQ.0) CALL ZCHOUT('Warning: Ambiguous',2)
  312.             IF (OPTION.EQ.-1)  CALL ZCHOUT('Warning: Unknown',2)
  313.             CALL ZCHOUT(' Option "',2)
  314.             CALL PUTLIN(LHS,2)
  315.             CALL ZMESS('" Ignored',2)
  316.         ELSE IF (OPTION.EQ.1.OR.OPTION.EQ.2) THEN
  317.             IF (RHS(1).EQ.129) THEN
  318. C set up default of "yes" if just "comment_check" or "list" input
  319.                 RHS(1)=121
  320.                 RHS(2)=129
  321.                 CALL ZCHOUT('Warning: Missing Argument to option: "',
  322.      +                      2)
  323.                 CALL PUTLIN(LHS,2)
  324.                 CALL ZMESS('" - assuming "Yes"',2)
  325.             END IF
  326.             OPTARG=ZKWLUK(RHS,YESNOX)
  327.             IF (OPTARG.LE.0) THEN
  328.                 CALL ZCHOUT('Warning: Bad Argument to option: "',2)
  329.                 CALL PUTLIN(STRING,2)
  330.                 CALL ZMESS('" : Ignored',2)
  331.             ELSE IF (OPTION.EQ.1) THEN
  332.                 CHKCMT=OPTARG.EQ.1
  333.             ELSE
  334.                 LSTDIF=OPTARG.EQ.1
  335.             END IF
  336.         ELSE IF (OPTION.EQ.3) THEN
  337.             OPTARG=ZKWLUK(RHS,MODE)
  338.             IF (OPTARG.LE.0) THEN
  339.                 CALL ZCHOUT('Warning: Bad Argument to option: "',
  340.      +                      2)
  341.                 CALL PUTLIN(LHS,2)
  342.                 CALL PUTCH(61,2)
  343.                 CALL PUTLIN(RHS,2)
  344.                 CALL ZMESS('" : Ignored',2)
  345.             ELSE
  346.                 TKMODE=(OPTARG.EQ.2)
  347.             END IF
  348.         ELSE IF (OPTION.EQ.4) THEN
  349.             IF (ALLDIG(RHS).NE.-2) THEN
  350.                 CALL REMARK('Warning: No Numerical Argument for NMATCH')
  351.             ELSE
  352.                 OPTARG=1
  353.                 NMATCH=CTOI(RHS,OPTARG)
  354.             END IF
  355.         ELSE IF (OPTION.EQ.6) THEN
  356.             IF (RHS(1).NE.129) CALL REMARK(
  357.      +'Warning: Unexpected argument to the QUICK option - ignored')
  358.             LSTDIF=.FALSE.
  359.             TKMODE=.TRUE.
  360.         END IF
  361.         GOTO 100
  362.  
  363.         END
  364. C ----------------------------------------------------------------------
  365. C
  366. C       I N P U T   -   Input routine.
  367. C
  368. C       Buffered input routine.  It doesn't fill the buffers - it only
  369. C       empties them.  Once they are empty, it will read one token (or
  370. C       statement, if in statement mode) at a time into the front of the
  371. C       buffer.
  372. C
  373. C       Begins with TBnCUR pointing to the last token (or first token of
  374. C       last statement) processed.
  375. C
  376. C       Returns with TBnCUR pointing to next tokens
  377. C
  378.  
  379.         SUBROUTINE INPUT
  380.  
  381.         COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
  382.      +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
  383.      +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  384.         INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
  385.      +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
  386.      +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
  387.      +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  388.  
  389.         COMMON/IN/TK1CTL,TK2CTL
  390.         INTEGER TK1CTL,TK2CTL
  391.  
  392.         COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
  393.         LOGICAL LSTDIF,CHKCMT,TKMODE
  394.         INTEGER NMATCH
  395.  
  396.         SAVE /BUFS/,/IN/,/OPTS/
  397.  
  398. C---------------------------------------------------------
  399. C    TOOLPACK/1    Release: 2.5
  400. C---------------------------------------------------------
  401. C
  402. C  TKLAST = LAST TOKEN NUMBER
  403. C
  404.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  405.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  406.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  407.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  408.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  409.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  410.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  411.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  412.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  413.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  414.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  415.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  416.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  417.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  418.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  419.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  420.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  421.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  422.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  423.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  424.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  425.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  426.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  427.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  428.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  429.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  430.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  431.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  432.  
  433.  
  434. C Lookahead variable for statement mode processing
  435.         INTEGER LUKAHD
  436.  
  437.         LOGICAL ENDSTM
  438.         EXTERNAL ENDSTM
  439.  
  440. C Set one-token lookback for intelligent token display etc.
  441.  100    IF (TKMODE) THEN
  442.             LASTB1=TB1TYP(TB1CUR)
  443.         ELSE
  444. C Statement mode: skip to end of statement
  445.  110        IF (TB1CUR.LT.TB1TOP.AND..NOT.ENDSTM(TB1TYP(TB1CUR))) THEN
  446.                 TB1CUR=TB1CUR+1
  447.                 IF (TB1PTR(TB1CUR).NE.0) TX1CUR=TB1PTR(TB1CUR)
  448.                 GOTO 110
  449.             ELSE
  450.                 LASTB1=TB1TYP(TB1CUR)
  451.             END IF
  452.         END IF
  453. C Now advance to next (token|statement)/read in next (token|statement)
  454.         IF (TB1CUR.NE.TB1TOP) THEN
  455.             TB1CUR=TB1CUR+1
  456.             NUNIT1=NUNIT1+1
  457.             IF (TB1PTR(TB1CUR).NE.0) TX1CUR=TB1PTR(TB1CUR)
  458. C If statement mode: must make sure an entire statement is in the buffer,
  459. C and read in the remainder if it is not so.
  460.             IF (.NOT.TKMODE) THEN
  461.                 LUKAHD=TB1CUR
  462.  120            IF(LUKAHD.LT.TB1TOP.AND..NOT.ENDSTM(TB1TYP(LUKAHD)))THEN
  463.                     LUKAHD=LUKAHD+1
  464.                     GOTO 120
  465.                 END IF
  466.                 IF (.NOT.ENDSTM(TB1TYP(LUKAHD))) THEN
  467.                     CALL ADJBUF(TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,
  468.      +                          TB1TOP,TX1CUR,TX1TOP,1)
  469.  130                CALL RDTOK(TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1TOP,TX1TOP
  470.      +                         ,TK1CTL)
  471.                     IF (.NOT.ENDSTM(TB1TYP(TB1TOP))) GOTO 130
  472.                 END IF
  473.             END IF
  474.         ELSE
  475.             TB1CUR=1
  476.             TB1TOP=0
  477.             TX1CUR=1
  478.             TX1TOP=0
  479.             IF (LASTB1.EQ.TZEOF) THEN
  480.                 TB1TYP(1)=TZEOF
  481.             ELSE
  482.  150            CALL RDTOK(TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1TOP,TX1TOP,
  483.      +                     TK1CTL)
  484.                 IF (.NOT.(TKMODE.OR.ENDSTM(TB1TYP(TB1TOP))).AND.
  485.      +              TB1TOP.LT.700) GOTO 150
  486.                 NUNIT1=NUNIT1+1
  487.             END IF
  488.         END IF
  489.         IF (TB1TYP(TB1CUR).EQ.TCMMNT.AND..NOT.CHKCMT) GOTO 100
  490.  200    IF (TKMODE) THEN
  491.             LASTB2=TB2TYP(TB2CUR)
  492.         ELSE
  493.  210        IF (TB2CUR.LT.TB2TOP.AND..NOT.ENDSTM(TB2TYP(TB2CUR))) THEN
  494.                 TB2CUR=TB2CUR+1
  495.                 IF (TB2PTR(TB2CUR).NE.0) TX2CUR=TB2PTR(TB2CUR)
  496.                 GOTO 210
  497.             ELSE
  498.                 LASTB2=TB2TYP(TB2CUR)
  499.             END IF
  500.         END IF
  501.         IF (TB2CUR.NE.TB2TOP) THEN
  502.             TB2CUR=TB2CUR+1
  503.             NUNIT2=NUNIT2+1
  504.             IF (TB2PTR(TB2CUR).NE.0) TX2CUR=TB2PTR(TB2CUR)
  505.             IF (.NOT.TKMODE) THEN
  506.                 LUKAHD=TB2CUR
  507.  220            IF(LUKAHD.LT.TB2TOP.AND..NOT.ENDSTM(TB2TYP(LUKAHD)))THEN
  508.                     LUKAHD=LUKAHD+1
  509.                     GOTO 220
  510.                 END IF
  511.                 IF (.NOT.ENDSTM(TB2TYP(LUKAHD))) THEN
  512.                     CALL ADJBUF(TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,
  513.      +                          TB2TOP,TX2CUR,TX2TOP,1)
  514.  230                CALL RDTOK(TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2TOP,TX2TOP
  515.      +                         ,TK2CTL)
  516.                     IF (TB2TOP.LT.700.AND..NOT.ENDSTM(TB2TYP(TB2TOP))
  517.      +              ) GOTO 230
  518.                 END IF
  519.             END IF
  520.        ELSE
  521.             TB2CUR=1
  522.             TB2TOP=0
  523.             TX2CUR=1
  524.             TX2TOP=0
  525.             IF (LASTB2.EQ.TZEOF) THEN
  526.                 TB2TYP(1)=TZEOF
  527.             ELSE
  528.  250            CALL RDTOK(TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2TOP,TX2TOP,
  529.      +                     TK2CTL)
  530.                 IF (TB2TOP.LT.700.AND..NOT.(ENDSTM(TB2TYP(TB2TOP))
  531.      +              .OR.TKMODE)) GOTO 250
  532.                 NUNIT2=NUNIT2+1
  533.             END IF
  534.         END IF
  535.         IF (TB2TYP(TB2CUR).EQ.TCMMNT.AND..NOT.CHKCMT) GOTO 200
  536.         RETURN
  537.         END
  538.  
  539.  
  540. C ----------------------------------------------------------------------
  541. C
  542. C       E N D S T M   -   Treat this token as end-of-statement?
  543. C                         (i.e. TZEOS/TZEOF/TCMMNT)
  544. C
  545.  
  546.         LOGICAL FUNCTION ENDSTM(TYPE)
  547.         INTEGER TYPE
  548.  
  549. C---------------------------------------------------------
  550. C    TOOLPACK/1    Release: 2.5
  551. C---------------------------------------------------------
  552. C
  553. C  TKLAST = LAST TOKEN NUMBER
  554. C
  555.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  556.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  557.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  558.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  559.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  560.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  561.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  562.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  563.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  564.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  565.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  566.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  567.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  568.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  569.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  570.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  571.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  572.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  573.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  574.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  575.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  576.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  577.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  578.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  579.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  580.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  581.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  582.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  583.  
  584.  
  585.         ENDSTM=(TYPE.EQ.TZEOS .OR. TYPE.EQ.TZEOF .OR. TYPE.EQ.TCMMNT)
  586.  
  587.         END
  588. C ----------------------------------------------------------------------
  589. C
  590. C       R D T O K   -   Read token into a buffer.
  591. C
  592.  
  593.         SUBROUTINE RDTOK(TYPBUF,LENBUF,PTRBUF,TXTBUF,NEXT,TXTTOP,CNTRL)
  594.         INTEGER TYPBUF(*),LENBUF(*),PTRBUF(*),TXTBUF(*),NEXT,TXTTOP,
  595.      +          CNTRL, STATUS
  596.  
  597.         NEXT=NEXT+1
  598.  100    CALL ZGETTK(TYPBUF(NEXT),LENBUF(NEXT),TXTBUF(TXTTOP+1),
  599.      +              CNTRL, STATUS)
  600.         IF (STATUS.NE.-2)
  601.      +     CALL ERROR('ISTFD Internal Error - Token Read Failed')
  602.         IF (LENBUF(NEXT).GT.0) THEN
  603.             PTRBUF(NEXT)=TXTTOP+1
  604.             TXTTOP=TXTTOP+LENBUF(NEXT)
  605.         ELSE
  606.             PTRBUF(NEXT)=0
  607.         END IF
  608.  
  609.         END
  610. C ----------------------------------------------------------------------
  611. C
  612. C       D I F R N T   -   Compare two items, which may be either tokens
  613. C                         or statements, for non-equality.
  614. C
  615. C       When in Statement Mode:
  616. C           If either or both of the token streams in the buffer run out
  617. C           before we detect an end of statement, then we will consider
  618. C           the two statements as being DIFFERENT (as we cannot be sure
  619. C           that they are the same).
  620. C
  621.  
  622.         LOGICAL FUNCTION DIFRNT(P1,P2)
  623.         INTEGER P1,P2
  624.  
  625.         COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
  626.      +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
  627.      +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  628.         INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
  629.      +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
  630.      +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
  631.      +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  632.  
  633.         COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
  634.         INTEGER NMATCH
  635.         LOGICAL LSTDIF,CHKCMT,TKMODE
  636.  
  637.         LOGICAL DIFTOK,ENDSTM
  638.         EXTERNAL DIFTOK,ENDSTM
  639.  
  640.         SAVE /BUFS/,/OPTS/
  641.  
  642.         INTEGER I
  643.  
  644.         IF (TKMODE) THEN
  645.             DIFRNT=DIFTOK(P1,P2)
  646.         ELSE
  647.             I=0
  648.  100        IF (DIFTOK(P1+I,P2+I)) THEN
  649.                 DIFRNT=.TRUE.
  650.             ELSE
  651. C Statements are the same so far: see if that is the end
  652.                 IF (ENDSTM(TB1TYP(P1+I))) THEN
  653.                     DIFRNT=.FALSE.
  654. C ... or see if we have run out of one of them
  655.                 ELSE IF (P1+I.EQ.TB1TOP .OR. P2+I.EQ.TB2TOP) THEN
  656.                     DIFRNT=.TRUE.
  657.                 ELSE
  658. C ... Not finished and still more to go: so keep going
  659.                     I=I+1
  660.                     GOTO 100
  661.                 END IF
  662.             END IF
  663.         END IF
  664.  
  665.         END
  666. C ----------------------------------------------------------------------
  667. C
  668. C       D I F T O K   -   Are two tokens different?
  669. C
  670.  
  671.         LOGICAL FUNCTION DIFTOK(P1,P2)
  672.         INTEGER P1,P2
  673.  
  674.         COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
  675.      +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
  676.      +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  677.         INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
  678.      +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
  679.      +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
  680.      +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  681.  
  682.         INTEGER I
  683.  
  684.         SAVE /BUFS/
  685.  
  686.         DIFTOK=.TRUE.
  687.         IF (TB1TYP(P1).EQ.TB2TYP(P2) .AND.
  688.      +      TB1LEN(P1).EQ.TB2LEN(P2)) THEN
  689.             DIFTOK=.FALSE.
  690.             IF (TB1LEN(P1).NE.0) THEN
  691.                 DO 100 I=0,TB1LEN(P1)-1
  692.                     IF (TB1TXT(TB1PTR(P1)+I).NE.TB2TXT(TB2PTR(P2)+I))
  693.      +                  DIFTOK=.TRUE.
  694.  100            CONTINUE
  695.             END IF
  696.         END IF
  697.  
  698.         END
  699. C ----------------------------------------------------------------------
  700. C
  701. C       D O D I F   -   Process a difference which has been detected
  702. C
  703. C       This routine sets up the conditions for the difference finding
  704. C       and then calls the FNDDIF and REPDIF routines to do the actual
  705. C       finding and reporting of the difference.
  706. C       This setup consists of calling the appropriate routines to fix
  707. C       up the internal buffers.
  708. C
  709.  
  710.         SUBROUTINE DODIF
  711.  
  712.         COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
  713.      +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
  714.      +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  715.         INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
  716.      +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
  717.      +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
  718.      +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  719.  
  720.         COMMON/IN/TK1CTL,TK2CTL
  721.         INTEGER TK1CTL,TK2CTL
  722.  
  723.         COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
  724.         INTEGER NMATCH
  725.         LOGICAL LSTDIF,CHKCMT,TKMODE
  726.  
  727.         SAVE /BUFS/,/IN/,/OPTS/
  728.  
  729.         INTEGER I,P
  730.  
  731.         IF (TB1CUR.NE.1)
  732.      +      CALL ADJBUF(TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,
  733.      +                  TX1CUR,TX1TOP,1)
  734.         IF (TB2CUR.NE.1)
  735.      +      CALL ADJBUF(TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
  736.      +                  TX2CUR,TX2TOP,1)
  737.         CALL FILBUF(TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1TOP,TX1TOP,TK1CTL)
  738.         CALL FILBUF(TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2TOP,TX2TOP,TK2CTL)
  739.         CALL FNDDIF
  740.         CALL REPDIF
  741.         IF (TKMODE) THEN
  742.             NUNIT1=NUNIT1+TB1CUR-1
  743.             NUNIT2=NUNIT2+TB2CUR-1
  744.         ELSE
  745.             P=1
  746.             I=0
  747.  100        IF (P.LT.TB1CUR) THEN
  748.                 CALL ADVANC(P,TB1TYP,TB1TOP)
  749.                 I=I+1
  750.                 GOTO 100
  751.             END IF
  752.             NUNIT1=NUNIT1+I
  753.             P=1
  754.             I=0
  755.  200        IF (P.LT.TB2CUR) THEN
  756.                 CALL ADVANC(P,TB2TYP,TB2TOP)
  757.                 I=I+1
  758.                 GOTO 200
  759.             END IF
  760.             NUNIT2=NUNIT2+I
  761.         END IF
  762.         LASTB1=TB1TYP(TB1CUR)
  763.         LASTB2=TB2TYP(TB2CUR)
  764.  
  765.         END
  766. C ----------------------------------------------------------------------
  767. C
  768. C       A D J B U F   -   Adjust buffer so that current is at the top.
  769. C
  770. C       This routine shifts the portion of a token buffer from CURENT
  771. C       to TOP down to BOTTOM, and adjusts CURENT and TOP accordingly.
  772. C       It also compacts the associated text buffer.
  773. C
  774.  
  775.         SUBROUTINE ADJBUF(TYPBUF,LENBUF,PTRBUF,TXTBUF,CURENT,TOP,TXCURR
  776.      +                    ,TXTTOP,BOTTOM)
  777.         INTEGER TYPBUF(*),LENBUF(*),PTRBUF(*),TXTBUF(*),CURENT,TOP,
  778.      +          TXCURR,TXTTOP,BOTTOM
  779.  
  780.         INTEGER I
  781.  
  782.         DO 100 I=BOTTOM,TOP-CURENT+BOTTOM
  783.             TYPBUF(I)=TYPBUF(I+CURENT-BOTTOM)
  784.             PTRBUF(I)=PTRBUF(I+CURENT-BOTTOM)
  785.             IF (PTRBUF(I).NE.0) PTRBUF(I)=PTRBUF(I)-TXCURR+1
  786. 100         LENBUF(I)=LENBUF(I+CURENT-BOTTOM)
  787.         TOP=TOP-CURENT+BOTTOM
  788.         CURENT=BOTTOM
  789.  
  790. C Now shift text about if necessary (already changed pointers)
  791.  
  792.         IF (TXCURR.GT.1) THEN
  793.             DO 200 I=1,TXTTOP-TXCURR+1
  794.  200        TXTBUF(I)=TXTBUF(I+TXCURR-1)
  795.             TXTTOP=TXTTOP-TXCURR+1
  796.             TXCURR=1
  797.         END IF
  798.  
  799.         END
  800. C ----------------------------------------------------------------------
  801. C
  802. C       F I L B U F   -   Fill input buffer
  803. C
  804. C       This routine fills an input buffer until it is in danger of
  805. C       overflowing.
  806. C
  807.  
  808.         SUBROUTINE FILBUF(TYPBUF,LENBUF,PTRBUF,TXTBUF,TOP,TXTTOP,CNTRL)
  809.         INTEGER TYPBUF(*),LENBUF(*),PTRBUF(*),TXTBUF(*),TOP,TXTTOP,CNTRL
  810.  
  811. C---------------------------------------------------------
  812. C    TOOLPACK/1    Release: 2.5
  813. C---------------------------------------------------------
  814. C
  815. C  TKLAST = LAST TOKEN NUMBER
  816. C
  817.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  818.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  819.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  820.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  821.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  822.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  823.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  824.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  825.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  826.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  827.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  828.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  829.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  830.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  831.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  832.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  833.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  834.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  835.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  836.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  837.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  838.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  839.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  840.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  841.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  842.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  843.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  844.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  845.  
  846.  
  847. C Assumes that the buffer already has at least one token in it
  848.  
  849.  100    IF (TYPBUF(TOP).NE.TZEOF .AND. TOP.LT.700 .AND.
  850.      +      TXTTOP.LT.4000-1322) THEN
  851.             CALL RDTOK(TYPBUF,LENBUF,PTRBUF,TXTBUF,TOP,TXTTOP,CNTRL)
  852.             GO TO 100
  853.         END IF
  854.  
  855.         END
  856. C ----------------------------------------------------------------------
  857. C
  858. C       F N D D I F   -   Find difference
  859. C
  860. C       Discovers the extent of the difference and sets the buffer
  861. C       pointers to the end of it.
  862. C
  863. C Note: Assumes that both buffers are adjusted and filled.
  864. C
  865.  
  866.         SUBROUTINE FNDDIF
  867.  
  868.         COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
  869.      +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
  870.      +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  871.         INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
  872.      +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
  873.      +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
  874.      +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  875.  
  876.         COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
  877.         INTEGER NMATCH
  878.         LOGICAL LSTDIF,CHKCMT,TKMODE
  879.  
  880. C---------------------------------------------------------
  881. C    TOOLPACK/1    Release: 2.5
  882. C---------------------------------------------------------
  883. C
  884. C  TKLAST = LAST TOKEN NUMBER
  885. C
  886.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  887.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  888.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  889.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  890.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  891.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  892.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  893.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  894.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  895.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  896.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  897.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  898.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  899.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  900.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  901.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  902.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  903.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  904.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  905.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  906.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  907.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  908.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  909.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  910.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  911.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  912.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  913.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  914.  
  915.  
  916.         SAVE /BUFS/,/OPTS/
  917.  
  918.         INTEGER I,P1,P2
  919.  
  920. C Logical function MATCH
  921.         LOGICAL MATCH
  922.  
  923.         EXTERNAL REMARK
  924.  
  925.         IF (TB1TOP.EQ.1 .OR. TB2TOP.EQ.1) THEN
  926. C We must have hit an end of file - a buffer is almost empty
  927.             TB1CUR=TB1TOP
  928.             TB2CUR=TB2TOP
  929.             RETURN
  930.         END IF
  931.         IF (TKMODE) THEN
  932. C ===========================================TOKEN MODE
  933.             DO 250 I=2,MAX(TB1TOP,TB2TOP)
  934.                 IF (TB2TOP.GE.I) THEN
  935.                     TB2CUR=I
  936.                     DO 100 TB1CUR=1,MIN(TB1TOP-NMATCH+1,I)
  937.                         IF (MATCH()) RETURN
  938.  100                CONTINUE
  939.                 END IF
  940.                 IF (TB1TOP.GE.I) THEN
  941. C       "I-1" in this loop as the (I,I) comparison done in previous loop
  942.                     TB1CUR=I
  943.                     DO 200 TB2CUR=1,MIN(TB2TOP-NMATCH+1,I-1)
  944.                         IF (MATCH()) RETURN
  945.  200                CONTINUE
  946.                 END IF
  947.  250        CONTINUE
  948.         ELSE
  949. C ===========================================STATEMENT MODE
  950.             P1=1
  951.             P2=1
  952.             CALL ADVANC(P1,TB1TYP,TB1TOP)
  953.             CALL ADVANC(P2,TB2TYP,TB2TOP)
  954.  500        IF (TB2TOP.GE.P2) THEN
  955.                 TB2CUR=P2
  956.                 TB1CUR=1
  957.  600            IF (MATCH()) RETURN
  958.                 CALL ADVANC(TB1CUR,TB1TYP,TB1TOP)
  959.                 IF (TB1CUR.LE.MIN(TB1TOP-NMATCH+1,P1)) GOTO 600
  960.             END IF
  961.             IF (TB1TOP.GE.P1) THEN
  962.                 TB1CUR=P1
  963.                 TB2CUR=1
  964.  700            IF (MATCH()) RETURN
  965.                 CALL ADVANC(TB2CUR,TB2TYP,TB2TOP)
  966. C (P2-1) here as the (P1,P2) comparison already done above
  967.                 IF (TB2CUR.LE.MIN(TB2TOP-NMATCH+1,P2-1)) GOTO 700
  968.             END IF
  969.             CALL ADVANC(P1,TB1TYP,TB1TOP)
  970.             CALL ADVANC(P2,TB2TYP,TB2TOP)
  971.             IF (P1.LT.TB1TOP.OR.P2.LT.TB2TOP) GOTO 500
  972.         END IF
  973. C ===========================================END OF STATEMENT MODE
  974.         IF (TB1TYP(TB1TOP).NE.TZEOF .OR. TB2TYP(TB2TOP).NE.TZEOF)
  975.      +CALL REMARK('Warning: The programs look completely different')
  976.         TB1CUR=TB1TOP
  977.         TB2CUR=TB2TOP
  978.  
  979.         END
  980. C ----------------------------------------------------------------------
  981. C
  982. C       A D V A N C   -   Advance pointer to beginning of next statement
  983. C                       :if end of buffer encountered, TOP+1 is returned
  984. C
  985.         SUBROUTINE ADVANC(P,TYPE,TOP)
  986.         INTEGER P,TYPE(*),TOP
  987.  
  988. C---------------------------------------------------------
  989. C    TOOLPACK/1    Release: 2.5
  990. C---------------------------------------------------------
  991. C
  992. C  TKLAST = LAST TOKEN NUMBER
  993. C
  994.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  995.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  996.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  997.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  998.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  999.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1000.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1001.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1002.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1003.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1004.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1005.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1006.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1007.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1008.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1009.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1010.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1011.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1012.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1013.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1014.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1015.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1016.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1017.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1018.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1019.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1020.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1021.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1022.  
  1023.  
  1024.         LOGICAL ENDSTM
  1025.         EXTERNAL ENDSTM
  1026.  
  1027.  100    P=P+1
  1028.         IF (P.LE.TOP.AND..NOT.ENDSTM(TYPE(P-1))) GOTO 100
  1029.         IF (.NOT.ENDSTM(TYPE(P-1))) P=TOP+1
  1030.  
  1031.         END
  1032. C -----------------------------------------------------------------------
  1033. C
  1034. C       M A T C H   -   See if we have found a match which ends the
  1035. C                       difference at (TB1CUR,TB2CUR)
  1036. C
  1037.  
  1038.         LOGICAL FUNCTION MATCH()
  1039.  
  1040. C---------------------------------------------------------
  1041. C    TOOLPACK/1    Release: 2.5
  1042. C---------------------------------------------------------
  1043. C
  1044. C  TKLAST = LAST TOKEN NUMBER
  1045. C
  1046.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1047.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1048.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1049.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1050.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1051.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1052.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1053.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1054.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1055.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1056.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1057.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1058.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1059.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1060.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1061.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1062.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1063.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1064.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1065.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1066.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1067.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1068.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1069.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1070.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1071.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1072.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1073.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1074.  
  1075.  
  1076.         COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
  1077.      +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
  1078.      +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  1079.         INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
  1080.      +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
  1081.      +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
  1082.      +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  1083.  
  1084.         COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
  1085.         INTEGER NMATCH
  1086.         LOGICAL LSTDIF,CHKCMT,TKMODE
  1087.  
  1088.         SAVE /BUFS/,/OPTS/
  1089.  
  1090.         INTEGER N,N1,N2
  1091.  
  1092. C Local logical function:
  1093.         LOGICAL DIFRNT,ENDSTM
  1094.  
  1095.         MATCH=.FALSE.
  1096.         IF (DIFRNT(TB1CUR,TB2CUR)) RETURN
  1097.         N1=TB1CUR+1
  1098.         N2=TB2CUR+1
  1099.         DO 500 N=2,NMATCH
  1100.             IF (.NOT.CHKCMT) THEN
  1101.  100            IF (TB1TYP(N1).EQ.TCMMNT.AND.N1.LT.TB1TOP) THEN
  1102.                     N1=N1+1
  1103.                     GOTO 100
  1104.                 END IF
  1105.  200            IF (TB2TYP(N2).EQ.TCMMNT.AND.N2.LT.TB2TOP) THEN
  1106.                     N2=N2+1
  1107.                     GOTO 200
  1108.                 END IF
  1109.             END IF
  1110.             IF (.NOT.TKMODE) THEN
  1111.  300            IF (N1.LT.TB1TOP.AND..NOT.ENDSTM(TB1TYP(N1-1))) THEN
  1112.                     N1=N1+1
  1113.                     GOTO 300
  1114.                 END IF
  1115.  400            IF (N2.LT.TB2TOP.AND..NOT.ENDSTM(TB2TYP(N2-1))) THEN
  1116.                     N2=N2+1
  1117.                     GOTO 400
  1118.                 END IF
  1119.             END IF
  1120.             IF (DIFRNT(N1,N2)) RETURN
  1121.             IF (N1.LT.TB1TOP) N1=N1+1
  1122.             IF (N2.LT.TB2TOP) N2=N2+1
  1123.  500    CONTINUE
  1124.         MATCH=.TRUE.
  1125.  
  1126.         END
  1127. C ------------------------------------------------------------------------
  1128. C
  1129. C       R E P D I F   -   Report the difference found
  1130. C
  1131.  
  1132.         SUBROUTINE REPDIF
  1133.  
  1134. C---------------------------------------------------------
  1135. C    TOOLPACK/1    Release: 2.5
  1136. C---------------------------------------------------------
  1137. C
  1138. C  TKLAST = LAST TOKEN NUMBER
  1139. C
  1140.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1141.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1142.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1143.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1144.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1145.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1146.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1147.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1148.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1149.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1150.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1151.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1152.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1153.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1154.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1155.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1156.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1157.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1158.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1159.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1160.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1161.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1162.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1163.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1164.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1165.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1166.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1167.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1168.  
  1169.  
  1170.         COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
  1171.      +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
  1172.      +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  1173.         INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
  1174.      +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
  1175.      +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
  1176.      +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
  1177.  
  1178.         COMMON/ANSWER/CMTDIF,PRGDIF
  1179.         LOGICAL CMTDIF,PRGDIF
  1180.  
  1181.         COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
  1182.         INTEGER NMATCH
  1183.         LOGICAL LSTDIF,CHKCMT,TKMODE
  1184.  
  1185.         COMMON/IO/IODTK1,IODCM1,IODTK2,IODCM2,IODLST
  1186.         INTEGER IODTK1,IODCM1,IODTK2,IODCM2,IODLST
  1187.  
  1188.         SAVE /BUFS/,/ANSWER/,/OPTS/,/IO/
  1189.  
  1190.         INTEGER I,LIM1,LIM2
  1191.  
  1192.         EXTERNAL EXTRA,OUTPOS,OUTTOK
  1193.  
  1194.         EXTERNAL ZMESS
  1195.  
  1196.         DO 100 I=1,TB1CUR-1
  1197.             IF (TB1TYP(I).NE.TCMMNT) PRGDIF=.TRUE.
  1198.  100    CONTINUE
  1199.         DO 200 I=1,TB2CUR-1
  1200.             IF (TB2TYP(I).NE.TCMMNT) PRGDIF=.TRUE.
  1201.  200    CONTINUE
  1202.         CMTDIF=.NOT.PRGDIF
  1203.         IF (LSTDIF) THEN
  1204.             LIM1=TB1CUR
  1205.             LIM2=TB2CUR
  1206.             IF (.NOT.TKMODE) THEN
  1207.  300            IF (LIM1.LT.TB1TOP .AND. TB1TYP(LIM1).NE.TZEOS .AND.
  1208.      +            TB1TYP(LIM1).NE.TZEOF.AND.TB1TYP(LIM1).NE.TCMMNT) THEN
  1209.                     LIM1=LIM1+1
  1210.                     GOTO 300
  1211.                 END IF
  1212.  400            IF (LIM2.LT.TB2TOP .AND. TB2TYP(LIM2).NE.TZEOS .AND.
  1213.      +            TB2TYP(LIM2).NE.TZEOF.AND.TB2TYP(LIM2).NE.TCMMNT) THEN
  1214.                     LIM2=LIM2+1
  1215.                     GOTO 400
  1216.                 END IF
  1217.             END IF
  1218.             IF (TB1CUR.EQ.1) THEN
  1219.                 CALL EXTRA(2,NUNIT2,TB2CUR,NUNIT1,TB1TOP.EQ.1)
  1220.                 CALL OUTTOK(TB2TYP,TB2LEN,TB2PTR,TB2TXT,LIM2,LASTB2)
  1221.             ELSE IF (TB2CUR.EQ.1) THEN
  1222.                 CALL EXTRA(1,NUNIT1,TB1CUR,NUNIT2,TB2TOP.EQ.1)
  1223.                 CALL OUTTOK(TB1TYP,TB1LEN,TB1PTR,TB1TXT,LIM1,LASTB1)
  1224.             ELSE
  1225.                 IF (TKMODE) THEN
  1226.                    CALL ZMESS('Programs have differing tokens:',IODLST)
  1227.                 ELSE
  1228.                    CALL ZMESS('Programs have differing statements:',
  1229.      +                        IODLST)
  1230.                 END IF
  1231.                 CALL OUTPOS(1,NUNIT1)
  1232.                 CALL OUTTOK(TB1TYP,TB1LEN,TB1PTR,TB1TXT,LIM1,LASTB1)
  1233.                 CALL OUTPOS(2,NUNIT2)
  1234.                 CALL OUTTOK(TB2TYP,TB2LEN,TB2PTR,TB2TXT,LIM2,LASTB2)
  1235.             END IF
  1236.             CALL ZMESS('- - - - - - - - - - - - - - - - -',IODLST)
  1237.         END IF
  1238.  
  1239.         END
  1240. C ----------------------------------------------------------------------
  1241. C
  1242. C       E X T R A   -   Output appropriate message for extra code found
  1243. C
  1244. C       In token mode, this routine outputs the message
  1245. C           "Extra token in program # at token #
  1246. C                       (before token # of program #)"
  1247. C      or
  1248. C           "Extra tokens in program # at tokens # to #
  1249. C                     (before token # of program #)"
  1250. C       to the listing file.
  1251. C
  1252. C       In statement mode, the message
  1253. C           "Extra statement(s) in program # at statement #
  1254. C                       (before statement # of program #)"
  1255. C       is output.
  1256. C
  1257.         SUBROUTINE EXTRA(FILNUM,NUNITF,LIM,NTKO,EOF)
  1258.         INTEGER FILNUM,NUNITF,LIM,NTKO
  1259.         LOGICAL EOF
  1260.  
  1261.         COMMON/IO/IODTK1,IODCM1,IODTK2,IODCM2,IODLST
  1262.         INTEGER IODTK1,IODCM1,IODTK2,IODCM2,IODLST
  1263.  
  1264.         COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
  1265.         INTEGER NMATCH
  1266.         LOGICAL LSTDIF,CHKCMT,TKMODE
  1267.  
  1268.         SAVE /IO/,/OPTS/
  1269.  
  1270.         EXTERNAL ZCHOUT,ZPTINT,ZMESS
  1271.  
  1272.         IF (LIM.EQ.2 .AND. TKMODE) THEN
  1273.             CALL ZCHOUT('Extra token in program ',IODLST)
  1274.             CALL ZPTINT(FILNUM,1,IODLST)
  1275.             CALL ZCHOUT(' at token ',IODLST)
  1276.         ELSE IF (TKMODE) THEN
  1277.             CALL ZCHOUT('Extra tokens in program ',IODLST)
  1278.             CALL ZPTINT(FILNUM,1,IODLST)
  1279.             CALL ZCHOUT(' at tokens ',IODLST)
  1280.         ELSE
  1281.             CALL ZCHOUT('Extra statement(s) in program ',IODLST)
  1282.             CALL ZPTINT(FILNUM,1,IODLST)
  1283.             CALL ZCHOUT(' at statement ',IODLST)
  1284.         END IF
  1285.         CALL ZPTINT(NUNITF,1,IODLST)
  1286.         IF (LIM.GT.2 .AND. TKMODE) THEN
  1287.             CALL ZCHOUT(' to ',IODLST)
  1288.             CALL ZPTINT(NUNITF+LIM-1,1,IODLST)
  1289.         END IF
  1290.         IF (TKMODE) THEN
  1291.             CALL ZCHOUT(' (before token ',IODLST)
  1292.         ELSE
  1293.             IF (EOF) THEN
  1294.               CALL ZCHOUT(' (at end ',IODLST)
  1295.             ELSE
  1296.               CALL ZCHOUT(' (before statement ',IODLST)
  1297.             ENDIF
  1298.         END IF
  1299.         IF (.NOT.EOF) CALL ZPTINT(NTKO,1,IODLST)
  1300.         CALL ZCHOUT(' of program ',IODLST)
  1301.         CALL ZPTINT(3-FILNUM,1,IODLST)
  1302.         CALL ZMESS(')',IODLST)
  1303.  
  1304.         END
  1305. C ----------------------------------------------------------------------
  1306. C
  1307. C       O U T T O K   -   Display tokens to user
  1308. C
  1309. C       This routine lists the tokens in the buffer passed from 1 up to
  1310. C       LIM onto the listing file.
  1311. C       If the token before the difference is not an end-of-statement or
  1312. C       a comment, then '...' is output to the listing to indicate that
  1313. C       the tokens are starting in the middle of a statement.
  1314. C       Similiarly with the end of the difference.
  1315. C
  1316.  
  1317.         SUBROUTINE OUTTOK(TYPBUF,LENBUF,PTRBUF,TXTBUF,LIM,LAST)
  1318.         INTEGER TYPBUF(*),LENBUF(*),PTRBUF(*),TXTBUF(*),LIM,LAST,JUNK
  1319.  
  1320. C---------------------------------------------------------
  1321. C    TOOLPACK/1    Release: 2.5
  1322. C---------------------------------------------------------
  1323. C
  1324. C  TKLAST = LAST TOKEN NUMBER
  1325. C
  1326.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1327.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1328.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1329.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1330.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1331.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1332.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1333.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1334.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1335.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1336.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1337.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1338.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1339.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1340.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1341.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1342.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1343.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1344.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1345.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1346.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1347.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1348.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1349.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1350.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1351.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1352.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1353.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1354.  
  1355.  
  1356.         COMMON/IO/IODTK1,IODCM1,IODTK2,IODCM2,IODLST
  1357.         INTEGER IODTK1,IODCM1,IODTK2,IODCM2,IODLST
  1358.  
  1359.         SAVE /IO/
  1360.  
  1361.         INTEGER I,STRING(134)
  1362.  
  1363.         INTEGER ZTOKTX
  1364.         EXTERNAL ZMESS,PUTLIN,PUTCH,ZTOKTX
  1365.  
  1366.         IF (LAST.NE.TZEOS .AND. LAST.NE.TCMMNT)
  1367.      +      CALL ZCHOUT(' ......',IODLST)
  1368.         DO 100 I=1,LIM
  1369.             IF (LENBUF(I).EQ.0) THEN
  1370.               JUNK = ZTOKTX(TYPBUF(I),LENBUF(I),TXTBUF(1),STRING)
  1371.             ELSE
  1372.               IF (LENBUF(I).GT.132-4) THEN
  1373.                 TXTBUF(PTRBUF(I)+132-5)=129
  1374.                 LENBUF(I)=132-4
  1375.                 CALL REMARK('Warning: long token truncated')
  1376.               END IF
  1377.               JUNK=ZTOKTX(TYPBUF(I),LENBUF(I),TXTBUF(PTRBUF(I)),STRING)
  1378.             END IF
  1379.             CALL PUTLIN(STRING,IODLST)
  1380.             IF (TYPBUF(I).EQ.TCMMNT .OR. TYPBUF(I).EQ.TZEOS .OR.
  1381.      +          TYPBUF(I).EQ.TZEOF) THEN
  1382.                 CALL PUTCH(10,IODLST)
  1383.             ELSE IF (LENBUF(I).NE.0) THEN
  1384.                 CALL PUTCH(32,IODLST)
  1385.             END IF
  1386.  100    CONTINUE
  1387.         IF (TYPBUF(LIM).NE.TZEOF .AND. TYPBUF(LIM).NE.TZEOS.AND.
  1388.      +      TYPBUF(LIM).NE.TCMMNT) CALL ZMESS(' ......',IODLST)
  1389.  
  1390.         END
  1391. C ----------------------------------------------------------------------
  1392. C
  1393. C       O U T P O S   -   Display position within input file.
  1394. C
  1395. C       This routine outputs "Program # at token #" to the listing file.
  1396. C       (In statement mode, "token" is replaced by "statement").
  1397. C
  1398.  
  1399.         SUBROUTINE OUTPOS(FILNUM,NUNITF)
  1400.         INTEGER FILNUM,NUNITF
  1401.  
  1402.         COMMON/IO/IODTK1,IODCM1,IODTK2,IODCM2,IODLST
  1403.         INTEGER IODTK1,IODCM1,IODTK2,IODCM2,IODLST
  1404.  
  1405.         COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
  1406.         INTEGER NMATCH
  1407.         LOGICAL LSTDIF,CHKCMT,TKMODE
  1408.  
  1409.         SAVE /IO/,/OPTS/
  1410.  
  1411.         EXTERNAL ZPTINT,ZCHOUT,ZMESS
  1412.  
  1413.         CALL ZCHOUT('Program ',IODLST)
  1414.         CALL ZPTINT(FILNUM,1,IODLST)
  1415.         IF (TKMODE) THEN
  1416.             CALL ZCHOUT(' at token ',IODLST)
  1417.         ELSE
  1418.             CALL ZCHOUT(' at statement ',IODLST)
  1419.         END IF
  1420.         IF (NUNITF.EQ.0) THEN
  1421.             CALL ZPTINT(0,1,IODLST)
  1422.         ELSE
  1423.             CALL ZPTINT(NUNITF,1,IODLST)
  1424.         END IF
  1425.         CALL ZMESS(':',IODLST)
  1426.  
  1427.         END
  1428. C ----------------------------------------------------------------------
  1429. C
  1430. C       R E S U L T   -   Describe result of entire comparison.
  1431. C
  1432.  
  1433.         SUBROUTINE RESULT(CMTDIF,PRGDIF)
  1434.         LOGICAL CMTDIF,PRGDIF
  1435.  
  1436.         EXTERNAL ZMESS
  1437.  
  1438.         IF (PRGDIF) THEN
  1439.             CALL ZMESS('Programs are different',1)
  1440.         ELSE IF (CMTDIF) THEN
  1441.             CALL ZMESS('Only changes in comment lines encountered',1)
  1442.         ELSE
  1443.             CALL ZMESS('No meaningful differences encountered',1)
  1444.         END IF
  1445.  
  1446.         END
  1447.